MacWorld 1997 September/Macworld (1997-09).dmg/Serious Software/Cherwell Scientific Demos/pro Fit/pro Fit 5.0 demo (fpu).sea/pro Fit 5.0 demo (fpu)/External Modules/External modules sources/Pascal/Inverse erf.p

Text File | 1996-04-21 | 9KB | 279 lines

{*******************************************************************************}
{ ErrorFunction.p                                                    }
{                                                                 }
{                                                                 }
{ 27.1.95:        compatibility with Metrowerks Pascal CW 5 }
{ 26.9.94:        original version                                }
{*******************************************************************************}



unit user;

interface
{$IFC UNDEFINED THINK_PASCAL }
    uses
        Types, fp, proFit_interface;
{$ELSEC}
    uses
        proFit_interface;
{$ENDC}

{$MAIN}
    procedure main (selector: integer; pb: ExtModulesParamBlockPtr);



implementation

{ note: MPW users must make sure that the procedure main is at the beginning of the compiled code }
{ under Think Pascal, this is cared for by the compiler }
{ We let main call a function mainMain to make sure that the code starts with a jump to }
{ our entry point even when compiling under MPW Pascal }
    procedure mainMain (selector: integer; pb: ExtModulesParamBlockPtr);
    forward;
    procedure main (selector: integer; pb: ExtModulesParamBlockPtr);

    begin
        mainMain(selector, pb);
    end;


{***********************************************************************************************}

    procedure SetUp (var moduleKind: integer;    { set moduleKind to isFunction or isProgram }
                                    var name: Str255;             { the name of the program or function }
                                    var requiredGlobals: longint;     { the number of bytes to be allocated in ExtModulesParamBlock.globals }
                                        { set requiredGlobals to 0 if you don't use this feature }
                                    pb: ExtModulesParamBlockPtr);    { the complete parameter block passed by pro Fit to the }
                                        { routines defined in this file. In most cases it can be ignored }
{ SetUp is called once when the external module is linked to pro Fit }
    begin
        moduleKind := isFunction;
        name := 'Inverse erf';
        requiredGlobals := 0;
    end;



{***********************************************************************************************}

    procedure InitializeFunc (var hasDerivatives: boolean;    { set this to true if and only if you define the function }
                                                { Derivatives to calculate the partial derivatives of the parameters }
                                    var descr1stLine, descr2ndLine: Str255;     { The two lines of the text in the parameter window }
                                    var numberOfParams: integer;             { the number of parameters of the function }
                                    var a0: DefaultParamInfo;                 { the default names, values etc. of the parameters }
                                    pb: ExtModulesParamBlockPtr);            { the complete parameter block passed by pro Fit to the }
                                                { routines defined in this file. In most cases it can be ignored }
{ InitializeFunc is called once (after SetUp has been called) when the external module is linked to pro Fit }
{ Used to set all the information needed to describe a function }
        var
            infinite: extended;
    begin
        infinite := 1 / 0;
        hasDerivatives := false;

        descr1stLine := 'The inverse of the error function.';
        descr2ndLine := 'y := A*InvErf(x-x0) + const';

        numberOfParams := 3;



{   The following is to set parameter names, fitting modes, etc.                     }
{   There are two ways for doing this. The first one sets values, names, etc            }
{   by directly setting the parameter arrays. The second one sets these things            }
{   by using the function "SetParamDefaults", provided by proFit through proFit_interface.p.}
{   In this example, we use both ways.}

        a0.value^[1] := 1;
        a0.mode^[1] := inactive;
        a0.name^[1] := 'A';

        a0.value^[2] := 0;
        a0.mode^[2] := inactive;
        a0.name^[2] := 'x0';

        a0.value^[3] := 0;
        a0.mode^[3] := inactive;
        a0.name^[3] := 'const';

    end;



{***********************************************************************************************}

    function Check (ParamNo: integer;             { the parameter that was changed }
                                    var a0: DefaultParamInfo;         { the default names, values etc. of the parameters }
                                    pb: ExtModulesParamBlockPtr    { the complete parameter block passed by pro Fit to the}
                                        { routines defined in this file. In most cases it can be ignored }
                                    ): CheckPAnswer;
    { Can be left emtpy (returning good) if not needed. }
    { called when the user has changed a value in the parameters window. This routine }
    { can then check if this parameters is fine. It can also change some of the }
    { other entries in a0. The returned values can be: }
    {    good:        return this value if you agree with the new parameter value }
    {    update:        return this value if you want the parameters window }
    {                to be updated because you changed some of the values in a0 }
    {    bad:        return this value if you want the new parameter value to be refused }
    begin
        Check := good;    { we have nothing to do }
    end;



{***********************************************************************************************}

    procedure First (a: ParamArray;             { the new parameters }
                                    pb: ExtModulesParamBlockPtr);    { the complete parameter block passed by pro Fit to the}
                                        { routines defined in this file. In most cases it can be ignored }

{ Can be left emtpy if not needed. }
{ Called whenever the parameters were changed. Can be used to accelerate }
{ some calculations. See manual for more info }
    begin
    end;



{***********************************************************************************************}

    function InvErf (x: extended): extended;
{ returns the inverse of the error function }
{ accuracy better than 1e-7 }
{ this function was inspired by A.J. Strecok, math. comp. 1968, page 144ff }
{ accuracy between -0.999 and 0.999: better than 10E-7 }
{ (C) 1996 QuantumSoft }
        var
            y: extended;
    begin
{$IFC UNDEFINED __FP__}
        y := sqrt(-ln(1.0 - x * x));
{$ELSEC}
        y := sqrt(-log(1.0 - x * x));
{$ENDC}

        y := y * (0.6374868939151371 + y * (-0.2767067324742911 + y * (0.1503581502062744 + y * (-2.5878691411691874e-2 + y * 9.7670209741420530e-3)))) / (0.7193322618853618 + y * (-0.3122885268724753 + y * (0.1614016565020622 + y * (-2.5947254488147567e-2 + y * 9.7832443176615724e-3))));

        if x < 0 then
            y := -y;
        InvErf := y;
    end;


    procedure Func (x: extended;                 { the x-value }
                                    a: ParamArray;                { the parameters }
                                    var y: extended;             { the y-value }
                                    pb: ExtModulesParamBlockPtr);    { the complete parameter block passed by pro Fit to the}
                                        { routines defined in this file. In most cases it can be ignored }
{ called to calculate the y-value of your function for a given x and a given }
{ set of parameters }
    begin
        y := a[1] * InvErf(x - a[2]) + a[3];
    end;



{***********************************************************************************************}

    procedure Derivatives (x: extended;             { the x-value }
                                    a: ParamArray;                 { the parameters }
                                    var dyda: ParamArray;         { the derivatives }
                                    pb: ExtModulesParamBlockPtr);    { the complete parameter block passed by pro Fit to the }
                                        { routines defined in this file. In most cases it can be ignored }

    { Can be left empty if InitializeFunc sets hasDerivatives to false }
    { called to calculate the partial derivatives of the function with respect to }
    { its parameters. If you leave this function empty and set hasDerivatives to false in }
    { FuncInitialize, the derivatives will be calcuated numerically, otherwise pro Fit }
    { calls this function to obtain the values of ALL derivatives. }
    { As a result of the numerical calculation fitting will be slower }
    begin
    end;



{***********************************************************************************************}

    procedure Last (pb: ExtModulesParamBlockPtr);
{ Can be left emtpy if not needed. }
{ Called when calculating is through. See manual for more info }
    begin
    end;




{***********************************************************************************************}

    procedure CleanUp (pb: ExtModulesParamBlockPtr);
    { called when the function or program is removed from pro Fit's menus }
    { in most cases, this function can be empty }
    begin
    end;









{***********************************************************************************************}

{ This is the main procedure through which all calls to the external module go.                    }
{ Main takes care of calling the right procedure with the right parameters depending on        }
{ the value of "selector".                                                                            }
{ You don't need to touch this procedure                                                            }
    procedure mainMain (selector: integer; pb: ExtModulesParamBlockPtr);
{$IFC NOT UNDEFINED SET_A4}
        var
            oldA4: longint;
{$ENDC}
    begin
{$IFC NOT UNDEFINED SET_A4}
        oldA4 := SetCurrentA4;
{$ENDC}
        Startup(pb);
        case selector of
            kSetup:
                begin
                    pb^.requiredGlobals := 0;
                    pb^.versionNumber := VERSIONNUMBER;
                    if sizeof(extended) = 10 then
                        pb^.codeType := CPU68noFPU
                    else if sizeof(extended) = 12 then
                        pb^.codeType := CPU68FPU
                    else
                        pb^.codeType := CPUPowerPC;

                    SetUp(pb^.moduleKind, pb^.name, pb^.requiredGlobals, pb);
                end;
            funcInitialize:
                begin
                    pb^.hasDerivatives := false;
                    InitializeFunc(pb^.hasDerivatives, pb^.descr1, pb^.descr2, pb^.numberOfParams, pb^.a0, pb);
                end;
            funcCheck:
                pb^.answer := ord(Check(pb^.paramNo, pb^.a0, pb));
            funcFirst:
                First(pb^.a^, pb);
            funcFunc:
                Func(pb^.x^, pb^.a^, pb^.y^, pb);
            funcDerivatives:
                Derivatives(pb^.x^, pb^.a^, pb^.dyda^, pb);
            funcLast:
                Last(pb);
            kcleanup:
                CleanUp(pb);
            otherwise
        end;
{$IFC NOT UNDEFINED SET_A4}
        oldA4 := SetA4(oldA4);
{$ENDC}
    end;


end.